home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
smaltalk
/
manchest.lha
/
MANCHESTER
/
usenet
/
st80_pre4
/
MVCTimeShare.st
< prev
next >
Wrap
Text File
|
1993-07-24
|
7KB
|
212 lines
" NAME MVCTimeShare
AUTHOR CWatts@BNR.CA (Carl Watts)
FUNCTION Stops MVC controllers consuming all the CPU cycles
ST-VERSION 2.5
PREREQUISITES
CONFLICTS
DISTRIBUTION world
VERSION 1
DATE 3 June 1991
SUMMARY
Change MVC Controllers so that they don't consume
100% of the CPU when they have control.
"!
"
From: CWatts@BNR.CA (Carl Watts)
Newsgroups: comp.lang.smalltalk
Subject: Making MVC Controllers in Smalltalk-80 v2.5 not consume 100% of the Processor
Message-ID: <1991Jun3.183729.20327@bqnes74.bnr.ca>
Date: Mon, 3 Jun 91 19:37:29 BST
Organization: Bell Northern Research
As I promised last week, here is my version of a modification to
Smalltalk-80 v2.5 to change MVC Controllers so that they don't consume
100% of the CPU when they have control.
This is very important if you have applications (like my Finder for
Smalltalk-80) that allow the users to do things by creating a Process
running at userBackgroundPriority (like Finder ST can do to move/copy
large directories in the background while you continue doing other
work in the foreground).
Without this modification to MVC Controllers, a Process running at
userBackgroundPriority will almost never get a chance to run.
There are several other implementations of ways to accomplish this
goal. Mine isn't necessarily any better, it just works. It isn't the
best solution either. Its just a good, simple solution.
Anyway... Here it is... The theory is simple. The InputState
signals a semaphore (called EventSemaphore) whenever a input event
comes in from the virtual machine. And then appropriate parts of the
Controller mechanism wait on this semaphore in their polling loops.
Simple.
"
'From Objectworks for Smalltalk-80(tm), Version 2.5 of 29 July 1989 on 5 November 1990 at 4:06:17 pm'!
'This fileIn is specifically ordered to fileIn appropriately...'!
(InputState classVarNames includes: #EventSemaphore)
ifFalse: [InputState addClassVarName: 'EventSemaphore']!
!InputState methodsFor: 'initialize-release'!
install
"Initialize and connect the receiver to the hardware. Terminate the old input process if any."
"Modified by Carl Watts to initialize the new EventSemaphore as well."
InputProcess == nil ifFalse: [InputProcess terminate].
self initState.
EventSemaphore _ Semaphore new.
InputSemaphore _ Semaphore new.
IdleSemaphore _ Semaphore new.
InputProcess _ [IdleSemaphore signal. self run] newProcess.
InputProcess priority: Processor lowIOPriority.
InputProcess resume.
self primInputSemaphore: InputSemaphore! !
!InputState methodsFor: 'private'!
run
"This is the loop that actually processes input events."
"Modified by Carl Watts to nudge the EventSemaphore every time I get some kind of event from the OS."
| word type param |
[true]
whileTrue:
[InputSemaphore wait.
"Test for mouse X/Y events here to avoid an activation."
word _ self primInputWord.
type _ word bitShift: -12.
param _ word bitAnd: 4095.
"Mouse X" type = 1 ifTrue: [self mouseX: param]
"Mouse Y" ifFalse: [type = 2 ifTrue: [self mouseY: param]
"Key down" ifFalse: [type = 3 ifTrue: [self keyAt: param put: 1]
"Key up" ifFalse: [type = 4 ifTrue: [self keyAt: param put: 0]
"MetaInput"ifFalse: [type = 7 ifTrue: [self metaInput: word]
"Delta time"ifFalse: [type = 0 ifTrue: []
"Reset time"ifFalse: [type = 5 ifTrue: [self primInputWord; primInputWord]
ifFalse: [self error: 'Bad event type']]]]]]].
self nudge]! !
!InputState methodsFor: 'events'!
nudge
"Something interesting has happened, signal the event semaphore."
EventSemaphore signal!
pause
"Wait on the Event Semaphore for something interesting to happen."
EventSemaphore wait! !
!InputSensor methodsFor: 'events'!
nudge
"Something interesting has happened. Signal the event semaphore."
CurrentInputState nudge!
pause
"Wait on the Event Semaphore for something interesting to happen."
CurrentInputState pause! !
InputSensor install!
!Controller methodsFor: 'basic control sequence'!
controlLoop
"Sent by Controller|startUp as part of the standard control sequence.
Controller|controlLoop sends the message Controller|isControlActive to
test for loop termination. As long as true is returned, the loop
continues. When false is returned, the loop ends. Each time through
the loop, the message Controller|controlActivity is sent."
"Modified by Carl Watts to pause on the sensor in case nothing
interesting is happening."
[self isControlActive] whileTrue: [
Processor yield.
sensor pause.
self controlActivity].
sensor nudge! !
!ControlManager methodsFor: 'scheduling'!
searchForActiveController
"Find a scheduled controller that wants control and give control to
it. If none wants control, then see if the System Menu has been
requested."
"Modified by Carl Watts so that a scheduled controller does not take
control unless the mouse button is pressed. This gets rid of the
annoying window flipping to front just because you moved over it.
Also modified to pause on the sensor in case nothing interesting is
happening."
| newController |
(activeControllerProcess == nil or: [activeControllerProcess == Processor activeProcess])
ifFalse: [^self].
activeController _ nil.
Object errorSignal
handle: [:ex | "bad controller"
ScheduledControllers removeInvalidControllers.
ex restart]
"If the active controller's view is nil, MessageNotUnderstoodSignal
is raised and caught as ErrorSignal by the handler."
do: [[Processor yield.
screenController sensor pause.
newController _ (screenController sensor anyButtonPressed)
ifTrue: [
scheduledControllers
detect: [:aController | aController isControlWanted & (aController ~~ screenController)]
ifNone: [screenController isControlWanted
ifTrue: [screenController]
ifFalse: [nil]]]
ifFalse: [nil].
newController isNil] whileTrue].
self activeController: newController.
Processor terminateActive! !
!ScrollController methodsFor: 'scrolling'!
scroll
"Check to see whether the user wishes to jump, scroll up, or scroll down."
"Modified by Carl Watts to pause on the sensor in case nothing interesting is happening."
| savedCursor regionPercent |
self yellowMenuContainsCursor
ifTrue: [^self yellowMenuActivity].
savedCursor _ sensor currentCursor.
[self scrollBarOnlyContainsCursor]
whileTrue:
[Processor yield. sensor pause.
regionPercent _ 100 * (sensor cursorPoint x - scrollBar left) // scrollBar width.
regionPercent <= 40
ifTrue: [self scrollDown]
ifFalse: [regionPercent >= 60
ifTrue: [self scrollUp]
ifFalse: [self scrollAbsolute]]].
savedCursor show! !